'Option Explicit

Dim doc
Set doc = application.ActiveDocument
GetUserLicence(doc)
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim dict
set dict = createobject("scripting.dictionary")
main
dict.removeall
set dict = nothing	
set fso=nothing

sub main()		
	pageToDict
	dim selpage
	selpage = -1
	dim cmp,cmps	
	set cmps = doc.components(1)
	for each cmp in cmps
		if dict.Exists(cmp.name) = true then 
			selpage=dict(cmp.name)
			exit for
		end if		
	next
	if selpage=-1 then msgbox "error":exit sub
	
	
	doc.unhighlightall()
	dim x,y
	x = doc.Activeview.MousePositionX
	y = doc.Activeview.MousePositionY	
	dim compobj	
	dim ret
	dim ismove
	
	dim cmppin,cmppins
	For Each okey In dict.Keys
		if dict(okey) = selpage then			
			'on error resume next			
			set compobj = doc.findcomponent(okey)		
			if not compobj is nothing then								
				if compObj.placed = false then Call compObj.Place(X,Y,0,topSide,epcbAnchorNone,epcbUnitCurrent,epcbAngleUnitDegrees)
				compObj.highlighted=true	 		
			end if	
		end if		
	Next		
end sub
sub pageToDict()
	dim pagefile:pagefile = doc.path & "output\page.txt"
	dim fo
	set fo = fso.opentextfile(pagefile,1)
	dim freadall
	freadall= fo.readall
	fo.close
	set fo = nothing
	dim ncount:ncount = 0
	dim s,ls,i
	dim cs
	freadall = replace(freadall,chr(13),"")
	s= split(freadall,chr(10))
	ls = ubound(s)-lbound(s)+1
	for i=0 to ls-1
		if s(i)<>"" then
			cs = split(s(i),chr(9))
			if ubound(cs)-lbound(cs)+1>1 then dict.add cs(0),cs(1):ncount = ncount +1
		end if
	next
	if ncount = 0 then 
		msgbox "blank dict"
	end if
end sub

function checkroute(x,y,lyr)
	dim ret :ret = false
	dim layerObj,layerObjColl
	Set layerObj = application.Utility.NewLayerObject
    layerObj.ConductorLayer = lyr
	Set layerObjColl = application.Utility.NewLayerObjects
    layerObjColl.Add layerObj


	dim ob,obs
	dim delta:delta = 0
	Set obs = doc.Pick(x - delta, y - delta, x + delta, y + delta,1 or 2, layerObjColl, True, True, 0)
	If (Not obs Is Nothing) Then
		For Each ob In obs				
			'msgbox ob.ObjectClass
			'ob.highlighted = true
			If ob.ObjectClass = 1 then
				if ob.issmd = false then
					ret = true 
					exit for
				end if
			end if	
			If ob.ObjectClass = 2 Then 
				on error resume next
				if ob.type2=20 then ret = true:exit for
			End If
		Next			          
	end if
	
	checkroute = ret	
end function


'####################################################################
'####################################################################
'####################################################################
' Function to validate document
Private Function ValidateServer(docObj)
    Dim key, licenseServer, licenseToken
    key = docObj.Validate(0)
    Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")
    licenseToken = licenseServer.GetToken(key)
    Set licenseServer = nothing
    'On Error Resume Next
    Err.Clear
    docObj.Validate(licenseToken)
    If Err Then
        ValidateServer = 0    
    Else 
        ValidateServer = 1
    End If
End Function
sub GetUserLicence(docObj)
	If ValidateServer(docObj) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If	
end sub




